home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / swag / win_os2.swg / 0030_HUGE Objects unit.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-24  |  2KB  |  92 lines
  1. unit BigStuff;
  2. interface
  3. uses
  4.   Objects,
  5.   WinAPI;
  6.  
  7. type
  8.   PBigData = ^TBigData;
  9.   TBigData = object(TObject)
  10.     NumRecs: Longint;
  11.     RecSize: Word;
  12.     Start: Word;
  13.     constructor Init(ANumRecs: Longint; ARecSize: Word);
  14.     destructor Done; virtual;
  15.     procedure GetSetData(Index: Longint; var Data; SetData: Boolean);
  16.       virtual;
  17.   end;
  18. implementation
  19.  
  20. constructor TBigData.Init(ANumRecs: Longint; ARecSize: Word);
  21. begin
  22.   TObject.Init;
  23.   NumRecs := ANumRecs;
  24.   RecSize := ARecSize;
  25.   while 65536 mod RecSize <> 0 do Inc(RecSize);
  26.   Start := GlobalAlloc(gmem_Moveable, RecSize * NumRecs);
  27.   if Start = 0 then
  28.     Runerror(201);
  29. end;
  30.  
  31. destructor TBigData.Done;
  32. begin
  33.   TObject.Done;
  34.   GlobalFree(Start);
  35. end;
  36.  
  37. procedure TBigData.GetSetData(Index: Longint; var Data; SetData: Boolean);
  38. var
  39.   Selector, Offset: Word;
  40.   P: Pointer;
  41. begin
  42.   if Index >= NumRecs then
  43.     begin
  44.       RunError(201);
  45.     end;
  46.   Index := Index * RecSize;
  47.   Selector := (Index div 65536) * SelectorInc + Start;
  48.   OffSet := Index mod 65536;
  49.   P := GlobalLock(Selector);
  50.   P := Ptr(Selector, Offset);
  51.   if SetData then
  52.     Move(Data, P^, RecSize)
  53.   else
  54.     Move(P^, Data, RecSize);
  55.   GlobalUnlock(Selector);
  56. end;
  57.  
  58. type
  59.   PBigInt = ^TBigInt;
  60.   TBigInt = object(TBigData)
  61.     constructor Init(ANumRecs: Longint);
  62.     procedure PutItem(Index: Longint; Value: Integer);
  63.     function GetItem(Index: Longint): Integer;
  64.   end;
  65.  
  66. constructor TBigInt.Init(ANumRecs: Longint);
  67. begin
  68.   TBigData.Init(ANumRecs, SizeOf(Integer));
  69. end;
  70.  
  71. procedure TBigInt.PutItem(Index: Longint; Value: Integer);
  72. begin
  73.   TBigData.GetSetData(Index, Value, True);
  74. end;
  75.  
  76. function TBigInt.GetItem(Index: Longint): Integer;
  77. var
  78.   Value: Integer;
  79. begin
  80.   TBigData.GetSetData(Index, Value, False);
  81.   GetItem := Value;
  82. end;
  83.  
  84. var
  85.   BI: TBigInt;
  86. begin
  87.   BI.Init(200000);
  88.   BI.PutItem(100000, 777);
  89.   Writeln(BI.GetItem(100000));
  90.   BI.Done;
  91. end.
  92.